home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / nan_news / toolkit / madd.prg < prev    next >
Text File  |  1991-08-15  |  4KB  |  124 lines
  1. /*
  2.  * File......: MADD.PRG
  3.  * Author....: Jo W. French dba Practical Computing
  4.  * CIS ID....: 74731,1751
  5.  * Date......: $Date:   15 Aug 1991 23:03:58  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/madd.prv  $
  8.  * 
  9.  * The functions contained herein are the original work of Jo W. French
  10.  * and are placed in the public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/madd.prv  $
  16.  * 
  17.  *    Rev 1.2   15 Aug 1991 23:03:58   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.1   14 Jun 1991 19:52:14   GLENN
  21.  * Minor edit to file header
  22.  * 
  23.  *    Rev 1.0   01 Apr 1991 01:01:38   GLENN
  24.  * Nanforum Toolkit
  25.  *
  26.  */
  27.  
  28. /*  $DOC$
  29.  *  $FUNCNAME$
  30.  *     FT_MADD()
  31.  *  $CATEGORY$
  32.  *     Date/Time
  33.  *  $ONELINER$
  34.  *     Add or subtract months to/from a date
  35.  *  $SYNTAX$
  36.  *     FT_MADD( [ <dGivenDate> ], [ <nAddMonths> ], [ <lMakeEOM> ] )
  37.  *         -> dDate
  38.  *  $ARGUMENTS$
  39.  *     <dGivenDate> is any valid date in any date format. Defaults to
  40.  *     current system date if not supplied.
  41.  *
  42.  *     <nAddMonths> is the number of months to be added or subtracted.
  43.  *     Defaults to 0 if not supplied.
  44.  *
  45.  *     <lMakeEOM> is a logical variable indicating whether or not to
  46.        force the returned date to the last date of the month.  It only
  47.        affects the returned date if <dGivenDate> is an end-of-month date.
  48.  *     Defaults to false except for month of February.
  49.  *  $RETURNS$
  50.  *     A date.
  51.  *  $DESCRIPTION$
  52.  *     FT_MADD() adds or subtracts months to/from a given date.
  53.  *
  54.  *     If MakeEOM is passed and dGivenDate is the last day of a month,
  55.  *     if will return the EOM of calculated month.  Otherwise it will
  56.  *     return the same day as the day of the passed date.
  57.  *  $EXAMPLES$
  58.  *     dDate := CTOD( "09/15/90" )
  59.  *     ? FT_MADD( dDate, 1 )        // 10/15/90
  60.  *     ? FT_MADD( dDate, -2 )       // 07/15/90
  61.  *
  62.  *     // force EOM
  63.  *     dDate := CTOD( "04/30/91" )
  64.  *     ? FT_MADD( dDate, 1 )        // 05/30/91
  65.  *     ? FT_MADD( dDate, 1, .T. )   // 05/31/91  <- forced EOM
  66.  *     ? FT_MADD( dDate, 2 )        // 06/30/91
  67.  *     ? FT_MADD( dDate, 2, .T. )   // 06/30/91  <- June only has 30 days
  68.  *     ? FT_MADD( dDate, 3 )        // 07/30/91
  69.  *     ? FT_MADD( dDate, 3, .T. )   // 07/31/91  <- forced EOM
  70.  *
  71.  *  $SEEALSO$
  72.  *     FT_DAYOFYR() FT_DAYTOBOW()
  73.  *  $END$
  74. */
  75.  
  76. FUNCTION FT_MADD(dGivenDate,nAddMonths, lMakeEOM)
  77.   LOCAL nAdd, nAddIncr, nMonth, dTemp, lEOMFlag
  78.   LOCAL dRetVal, aTemp, cDateFormat := SET(_SET_DATEFORMAT, "yyyy.mm.dd")
  79.  
  80.   aTemp := {0,0,0}
  81.   dGivenDate := IIF(VALTYPE(dGivenDate) != 'D', DATE(), dGivenDate)
  82.   nAddMonths := IIF(VALTYPE(nAddMonths) != 'N', 0, nAddMonths)
  83.   lMakeEOM   := IIF(VALTYPE(lMakeEOM)   != 'L', .F., lMakeEOM)
  84.  
  85.   nMonth := MONTH(dGivenDate)
  86.  
  87.   lEOMFlag := .F.
  88.   IF lMakeEOM
  89.      /* Check if day entered is the end of the month entered.*/
  90.      dTemp := CTOD(STR(YEAR(dGivenDate) + IF(nMonth + 1 < 13, 0, 1 ), 4) + "." +;
  91.               STR(nMonth + IF( nMonth + 1 < 13, 1, - 11),2) + ".01") - 1
  92.      lEOMFlag := IF(DAY(dGivenDate) == DAY(dTemp), .T., lEOMFlag)
  93.   ENDIF
  94.  
  95.   nAddIncr := nAddMonths % 12
  96.  
  97.   IF nAddIncr == 0
  98.      aTemp[1] := YEAR(dGivenDate) + INT( nAddMonths / 12 )
  99.      aTemp[2] := nMonth
  100.   ELSEIF nAddIncr > 0
  101.      aTemp[1] := YEAR(dGivenDate) + IF( nMonth + nAddIncr < 13, 0, 1 ) +;
  102.                  INT(nAddMonths / 12)
  103.      aTemp[2] := nMonth + IF( nMonth + nAddIncr < 13, nAddIncr, nAddIncr - 12)
  104.   ELSE
  105.      aTemp[1] := YEAR(dGivenDate) - IF( nMonth + nAddIncr > 0, 0, 1 ) -;
  106.                  INT( ABS(nAddMonths) / 12 )
  107.      aTemp[2] := nMonth + IF( nMonth + nAddIncr > 0, nAddIncr, nAddIncr + 12 )
  108.   ENDIF
  109.  
  110.   /* Determine end of month day for calculated year and month.*/
  111.   dTemp := CTOD( STR(aTemp[1]+IF(aTemp[2]=12,1,0),4) + "." + ;
  112.                  STR(IF(aTemp[2]=12,1,aTemp[2]+1),2) + ".01") -1
  113.   IF lEOMFlag           // Force end of month.
  114.      dRetVal := dTemp
  115.   ELSE                  // Assure dGivenDate day not > end of calculated month.
  116.      aTemp[3] := IF( DAY(dGivenDate) > DAY(dTemp), DAY(dTemp), DAY(dGivenDate) )
  117.      dRetval := CTOD(STR(aTemp[1],4) + "." +STR(aTemp[2],2) +"."+STR(aTemp[3],2))
  118.   ENDIF
  119.  
  120.   SET(_SET_DATEFORMAT, cDateFormat)
  121.  
  122. RETURN dRetVal
  123.  
  124.